home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / m_to_r / picdll / squares.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  4.7 KB  |  204 lines
  1. unit Squares;
  2.  
  3. { Program copyright (c) 1995 by Charles Calvert }
  4. { Project Name: RUNDLL }
  5.  
  6. interface
  7.  
  8. uses
  9.   SysUtils, WinTypes, WinProcs,
  10.   Messages, Classes, Graphics,
  11.   Controls, Forms, Dialogs,
  12.   StdCtrls, ExtCtrls;
  13.  
  14. const
  15.   BoxCount = 25;
  16. type
  17.   TDrawSqr = class(TForm)
  18.     Timer1: TTimer;
  19.     procedure Timer1Timer(Sender: TObject);
  20.     procedure FormCreate(Sender: TObject);
  21.   private
  22.     { Private declarations }
  23.     Colors: array [1..BoxCount] of TColor;
  24.     procedure DrawSquare(Scale: Double; Theta: Integer);
  25.   public
  26.     { Public declarations }
  27.   end;
  28. var
  29.   DrawSqr: TDrawSqr;
  30.  
  31. procedure ShowSquares(Handle: THandle); export;
  32.  
  33. implementation
  34.  
  35. {$R *.DFM}
  36.  
  37. type
  38.   TSquarePoints = array [0..4] of TPoint;
  39.  
  40. const
  41.   Square : TSquarePoints =
  42.     ((x: -100; y: -100),(x: 100; y: -100),(x: 100; y: 100),
  43.      (x: -100; y: 100),(x: -100; y: -100));
  44.  
  45. procedure ShowSquares(Handle: THandle);
  46. begin
  47.   Application.Handle := Handle;
  48.   DrawSqr := TDrawSqr.Create(Application);
  49.   try
  50.     DrawSqr.ShowModal;
  51.   finally
  52.     DrawSqr.Free;
  53.   end;
  54. end;
  55.  
  56. procedure TDrawSqr.DrawSquare(Scale: Double; Theta: Integer);
  57. var
  58.   i: Integer;
  59.   CosTheta, SinTheta: Double;
  60.   Path: TSquarePoints;
  61. begin
  62.   CosTheta := Scale * cos(Theta * PI / 180);  { precalculate rotation and scaling }
  63.   SinTheta := Scale * sin(Theta * PI / 180);
  64.   for i := 0 to 4 do
  65.   begin
  66.     Path[i].X := Round(Square[i].X * CosTheta +  Square[i].Y * SinTheta);
  67.     Path[i].Y := Round(Square[i].Y * CosTheta -  Square[i].X * SinTheta);
  68.   end;
  69.   Canvas.Polyline(Path);
  70. end;
  71.  
  72. procedure TDrawSqr.Timer1Timer(Sender: TObject);
  73. var
  74.   i: Integer;
  75.   Scale: Double;
  76.   Theta: Integer;
  77. begin
  78.   Scale := 1.0;
  79.   Theta := 0;
  80.   SetViewPortOrg(Canvas.Handle, ClientWidth div 2, ClientHeight div 2);
  81.   Canvas.Pen.Color := clWhite;
  82.   for i := 1 to BoxCount do 
  83.   begin
  84.     DrawSquare(Scale, Theta);
  85.     Theta := Theta + 10;
  86.     Scale := Scale * 0.85;
  87.     Canvas.Pen.Color := Colors[i];
  88.   end;
  89.   { Shift all colors down one for special spinning effects }
  90.   Move(Colors[1], Colors[2], sizeof(Colors) - Sizeof(TColor));
  91.   Colors[1] := Colors[1] + RGB(Random(64), Random(64), Random(64));
  92. end;
  93.  
  94. procedure TDrawSqr.FormCreate(Sender: TObject);
  95. var
  96.   X: Integer;
  97. begin
  98.   Randomize;
  99.   Colors[1] := RGB(Random(255), Random(255), Random(255));
  100.   for X := 2 to BoxCount do
  101.     Colors[X] := Colors[X-1] + RGB(Random(64), Random(64), Random(64));
  102. end;
  103.  
  104. end.
  105.  
  106. ===============================================================
  107. type
  108.   TDrawSqr = class(TForm)
  109.     Timer1: TTimer;
  110.     procedure Timer1Timer(Sender: TObject);
  111.   private
  112.     { Private declarations }
  113.   public
  114.     { Public declarations }
  115.   end;
  116.  
  117. var
  118.   DrawSqr: TDrawSqr;
  119.  
  120. procedure ShowSquares; export;
  121.  
  122. implementation
  123.  
  124. {$R *.DFM}
  125.  
  126. procedure ShowSquares;
  127. begin
  128.   DrawSqr := TDrawSqr.Create(Application);
  129.   DrawSqr.ShowModal;
  130.   DrawSqr.Free;
  131. end;
  132.  
  133. procedure DrawSquare(PaintDC: HDC; Scale: Double; Theta: Integer);
  134. type
  135.   TCDS = array[0..5] of TPoint;
  136. var
  137.   X1, Y1: Integer;
  138.   XT, YT: Integer;
  139.   i, j: Integer;
  140.   Pens: array[0..4] of HPen;
  141.   OldPen: HPen;
  142.   CDS: TCDS;
  143. begin
  144.   j := Random(25);
  145.   Pens[0] := CreatePen(PS_SOLID, 1, RGB(255, 255, 255));
  146.   Pens[1] := CreatePen(PS_SOLID, 1, RGB(Random(255), 0, 0));
  147.   Pens[2] := CreatePen(PS_SOLID, 1, RGB(0, Random(255), 0));
  148.   Pens[3] := CreatePen(PS_SOLID, 1, RGB(0, 0, Random(255)));
  149.   Pens[4] := CreatePen(PS_SOLID, 1, RGB(Random(255), 0, Random(255)));
  150.  
  151.   CDS[0].X := -100;
  152.   CDS[0].Y := -100;
  153.   CDS[1].X := 100;
  154.   CDS[1].Y := -100;
  155.   CDS[2].X := 100;
  156.   CDS[2].Y := 100;
  157.   CDS[3].X := -100;
  158.   CDS[3].Y := 100;
  159.   CDS[4].X := -100;
  160.   CDS[4].Y := -100;
  161.  
  162.   for i := 0 to 4 do begin
  163.     x1 := CDS[i].X;
  164.     y1 := CDS[i].Y;
  165.     xt := Round(Scale * (x1 * cos(Theta * PI / 180) + y1 * sin(Theta * PI/180)));
  166.     yt := Round(Scale * (y1 * cos(Theta * PI / 180) - x1 * sin(Theta * PI/180)));
  167.     if (i = 0) then
  168.       MoveTo(PaintDC, xt, yt)
  169.     else begin
  170.       if Scale = 1.0 then
  171.         OldPen := SelectObject(PaintDC, Pens[0])
  172.       else
  173.         OldPen := SelectObject(PaintDC, Pens[i]);
  174.       LineTo(PaintDC, xt, yt);
  175.       SelectObject(PaintDC, OldPen);
  176.     end;
  177.   end;
  178.   for I := 0 to 4 do
  179.     DeleteObject(Pens[i]);
  180. end;
  181.  
  182. procedure TDrawSqr.Timer1Timer(Sender: TObject);
  183. var
  184.   i: Integer;
  185.   Scale: Double;
  186.   Theta: Integer;
  187.   PaintDC: HDC;
  188.   R: TRect;
  189. begin
  190.   Scale := 1.0;
  191.   Theta := 0;
  192.   PaintDC := GetDC(Handle);
  193.   R := GetClientRect;
  194.   SetViewPortOrg(PaintDC, R.Right div 2, R.Bottom div 2);
  195.   for i := 1 to 25 do begin
  196.     DrawSquare(PaintDC, Scale, Theta);
  197.     Theta := Theta + 10;
  198.     Scale := Scale * 0.85;
  199.   end;
  200.   ReleaseDC(Handle, PaintDC);
  201. end;
  202.  
  203. end.
  204.